﻿' This software is licensed under Microsoft Public License (Ms-PL), which governs use of the accompanying software. 
' If you use the software, you accept this license. 

' The software is licensed "as-is." You bear the risk of using it. The contributors give no express warranties, 
' guarantees or conditions. You may have additional consumer rights under your local laws which this license cannot 
' change. To the extent permitted under your local laws, the contributors exclude the implied warranties of 
' merchantability, fitness for a particular purpose and non-infringement.

Imports System.ServiceModel.Dispatcher
Imports System.Runtime.Serialization
Imports System.Xml
Imports System.ServiceModel
Imports System.ServiceModel.Description
Imports System.ServiceModel.Channels
Imports System.ServiceModel.Web

Namespace Dispatcher
    ''' <summary>
    ''' Inspects REST messages to raise client-side errors.
    ''' </summary>
    ''' <remarks></remarks>
    Friend Class RestErrorInspector
        Implements IClientMessageInspector

        Private Const ENVELOPE_NAMESPACE As String = "http://schemas.microsoft.com/ws/2005/05/envelope/none"

#Region "Constructor"
        ''' <summary>
        ''' Returns a new instance of the RestErrorInspector.
        ''' </summary>
        ''' <remarks></remarks>
        Public Sub New()
        End Sub
#End Region

#Region "IClientMessageInspector implementation"
        ''' <summary>
        ''' Enables inspection or modification of a message after a reply message is received.
        ''' </summary>
        ''' <param name="reply">Reply recieved from the service.</param>
        ''' <param name="correlationState"></param>
        ''' <remarks></remarks>
        Public Sub AfterReceiveReply(ByRef reply As Channels.Message, correlationState As Object) Implements System.ServiceModel.Dispatcher.IClientMessageInspector.AfterReceiveReply
            Dim exception As Exception = Nothing

            Dim messageBuffCopy As MessageBuffer = reply.CreateBufferedCopy(Int32.MaxValue)
            Dim message As Message = messageBuffCopy.CreateMessage ' copy to read in this inspecter
            reply = messageBuffCopy.CreateMessage ' create a new copy for next read

            If message.ToString() <> "" Then
                Try
                    Using bodyReader As Xml.XmlDictionaryReader = message.GetReaderAtBodyContents()
                        Dim errorDocument As Xml.XmlDocument = New Xml.XmlDocument()
                        errorDocument.Load(bodyReader)

                        If IsFault(errorDocument) Then
                            Dim code As Net.HttpStatusCode
                            Dim obj As Object = ReadFaultDetail(errorDocument, code)
                            If obj IsNot Nothing Then
                                exception = New System.ServiceModel.Rest.RestFaultException(obj, code)
                            End If
                        End If
                    End Using
                Catch ex As Exception
                    ' throw default exception (if not ReadFaultDetail is thrown service side)
                    Throw New Exception("Unhandled REST service exception. Please see service logs.")
                End Try
            End If
            If exception IsNot Nothing Then
                Throw exception
            End If
        End Sub

        ''' <summary>
        ''' Enables inspection or modification of a message before a request message is send. 
        ''' </summary>
        ''' <param name="request">Request to send.</param>
        ''' <param name="channel">Channel to send the request through.</param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function BeforeSendRequest(ByRef request As Channels.Message, channel As IClientChannel) As Object Implements System.ServiceModel.Dispatcher.IClientMessageInspector.BeforeSendRequest
            Return Nothing
        End Function
#End Region

#Region "Private Methods"
        ''' <summary>
        ''' Gets a value indicating if the message is a fault message.
        ''' </summary>
        ''' <param name="bodyDocument">Body of message to review.</param>
        ''' <returns>True if the message is characterized as a fault message.</returns>
        ''' <remarks></remarks>
        Private Function IsFault(ByVal bodyDocument As Xml.XmlDocument) As Boolean
            Return (bodyDocument.DocumentElement.Name = "Fault")
        End Function

        ''' <summary>
        ''' Read the details of the fault.
        ''' </summary>
        ''' <param name="reply">Reply to read.</param>
        ''' <param name="code">Returns the code of the HttpStatus.</param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Private Shared Function ReadFaultDetail(reply As Xml.XmlDocument, ByRef code As Net.HttpStatusCode) As Object
            Dim xmlns As XmlNamespaceManager = New XmlNamespaceManager(reply.NameTable)
            xmlns.AddNamespace("ev", ENVELOPE_NAMESPACE)

            Dim codeNode As XmlNode = reply.DocumentElement.SelectSingleNode("//ev:Reason", xmlns)
            If codeNode IsNot Nothing Then
                code = [Enum].Parse(GetType(Net.HttpStatusCode), codeNode.FirstChild.InnerText)
            End If

            Dim detailNode As XmlElement = reply.DocumentElement.ChildNodes(2).FirstChild
            Using xr As XmlReader = detailNode.CreateNavigator().ReadSubtree()
                Dim serializer As New DataContractSerializer(GetType(Rest.ErrorDetails))

                Try
                    Return serializer.ReadObject(xr)

                Catch ex As Runtime.Serialization.SerializationException
                    Return New CommunicationException("SerializationException", ex)
                Catch ex As Exception
                    Throw ex
                End Try
            End Using
        End Function
#End Region
    End Class
End Namespace